VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmAccessi 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Accessi effettuati"
   ClientHeight    =   5160
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   10785
   Icon            =   "frmAccessi.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5160
   ScaleWidth      =   10785
   Begin VB.Frame Frame3 
      Height          =   855
      Left            =   120
      TabIndex        =   3
      Top             =   4200
      Width           =   10575
      Begin VB.CommandButton cmdChiudi 
         Caption         =   "&Chiudi"
         CausesValidation=   0   'False
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   9000
         TabIndex        =   5
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton cmdStampa 
         Caption         =   "&Stampa "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   7320
         TabIndex        =   4
         Top             =   240
         Width           =   1335
      End
   End
   Begin VB.Frame Frame2 
      Height          =   4215
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   10575
      Begin MSFlexGridLib.MSFlexGrid flxGriglia 
         Height          =   3855
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   10335
         _ExtentX        =   18230
         _ExtentY        =   6800
         _Version        =   393216
         Cols            =   8
         FixedCols       =   0
         ScrollTrack     =   -1  'True
         FormatString    =   $"frmAccessi.frx":058A
      End
      Begin VB.Label lblFiltro 
         BackColor       =   &H00FFFFFF&
         Height          =   255
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Visible         =   0   'False
         Width           =   375
      End
   End
End
Attribute VB_Name = "frmAccessi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim tFiltro As structFiltro


Private Sub cmdChiudi_Click()
    Unload Me
End Sub

Private Sub cmdStampa_Click()
    frmFiltroStampa.Show 1
    Call Stampa
End Sub

Private Sub Stampa()
    Dim dataDal As String
    Dim dataAl As String
    Dim strUtente As String
    Dim strSql As String
    Dim strData As String
    
    Dim cnConn As Connection        ' connessione per lo shape
    Dim rsMain As Recordset         ' recordset padre per lo shape
    Dim rsDataset As Recordset
    
    
    Dim var As String

    strSql = "SHAPE APPEND " & _
                "       NEW adLongVarChar AS RIGA "

    
    If tStampe.utente <> tpTUTTI Then
        strUtente = " AND TIPO=" & tStampe.utente
    End If
    
    If Not tStampe.tutteLeDate Then
        dataDal = DateValue(Month(tStampe.dataDal) & "/" & Day(tStampe.dataDal) & "/" & Year(tStampe.dataDal))
        dataAl = DateValue(Month(tStampe.dataAl) & "/" & Day(tStampe.dataAl) & "/" & Year(tStampe.dataAl))
        strData = " AND (DATA BETWEEN #" & dataDal & "# AND #" & dataAl & "#) "
    End If

    ' apre la connessione per lo shape
    Set cnConn = New ADODB.Connection
    cnConn.Open "Data Provider=NONE; Provider=MSDataShape"
    Set rsMain = New ADODB.Recordset
    rsMain.Open strSql, cnConn, adOpenStatic, adLockOptimistic

    Set rsDataset = New Recordset
    rsDataset.Open "SELECT * FROM (LOGIN INNER JOIN ACCESSI ON LOGIN.KEY=ACCESSI.CODICE_UTENTE) WHERE TRUE " & strData & strUtente & " ORDER BY DATA DESC", cnPrinc, adOpenForwardOnly, adLockReadOnly, adCmdText
    If Not (rsDataset.EOF And rsDataset.BOF) Then
        Do While Not rsDataset.EOF
            With rsMain
                .AddNew
                var = Format(rsDataset("COGNOME"), "!" & String(20, "@")) & Format(rsDataset("NOME"), "!" & String(20, "@")) & Format(Choose(rsDataset("TIPO"), "Medico", "Infermiere", "Contabile", "Amministratore"), "!" & String(25, "@")) & Format(rsDataset("DATA"), "dd/mm/yyyy") & Space(10) & Format(rsDataset("ORA"), "Short Time") & Space(10) & Format(rsDataset("NOME_PC"), "!" & String(15, "@")) & IIf(rsDataset("TIPO_PC") = 1, "Server", "Client")
                'Debug.Print var
                .Fields("RIGA") = var
                .Update
            End With
            rsDataset.MoveNext
        Loop
    End If
    Set rsDataset = Nothing
        
    If rsMain.RecordCount = 0 Then
        MsgBox "Nessun accesso trovato", vbInformation, "Stampa accessi"
    Else
        Set rptAccessi.DataSource = rsMain
        rptAccessi.LeftMargin = 0
        rptAccessi.RightMargin = 0
        rptAccessi.PrintReport True, rptRangeAllPages
        Unload Me
    End If

End Sub


Private Sub Form_Activate()
    Me.ZOrder
    numFormAttivo = Me.Tag
    Call RicaricaFiltro(tFiltro)
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Me.Top = 0
    Me.Left = 10
    With flxGriglia
        .ColWidth(0) = 0
        .Row = 0
        For i = 1 To 7
            .Col = i
            .CellFontBold = True
        Next i
    End With
    Call CaricaFlx
    numFormAperti = numFormAperti + 1
    Me.Tag = numFormAperti
    If numFormAperti = 1 Then
        frmMain.Height = 10500
        frmMain.picSfondo.Height = 2175
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    numFormAperti = numFormAperti - 1
    If numFormAperti = 0 Then
        frmMain.Height = 9330
        frmMain.picSfondo.Height = 15
    End If
End Sub

Public Sub MouseWheel(flx As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
    Dim NewValue As Long
    Dim Lstep As Single

    On Error Resume Next
    With flx
        Lstep = .Height / .RowHeight(0)
        Lstep = Int(Lstep)
        If Lstep < 10 Then
            Lstep = 10
        End If
        If Rotation > 0 Then
            NewValue = .TopRow - Int(Lstep / 3)
            If NewValue < 1 Then
                NewValue = 1
            End If
        Else
            NewValue = .TopRow + Int(Lstep / 3)
            If NewValue > .Rows - 1 Then
                NewValue = .Rows - 1
            End If
        End If
        .TopRow = NewValue
    End With
End Sub

Private Sub CaricaFlx()
    Dim rsDataset As Recordset
    Dim dataInizio As Date
    Dim dataFine As Date
    Dim strData As String
    Dim strUtente As String
    Dim riga As Integer
    
    With tFiltro
        If .dataMin <> CDate("0.00.00") And .dataMax <> CDate("0.00.00") Then
            dataInizio = DateValue(Month(.dataMin) & "/" & Day(.dataMin) & "/" & Year(.dataMin))
            dataFine = DateValue(Month(.dataMax) & "/" & Day(.dataMax) & "/" & Year(.dataMax))
            strData = " AND DATA BETWEEN #" & dataInizio & "# AND #" & dataFine & "# "
        ElseIf (.dataMin <> CDate("0.00.00") And .dataMax = CDate("0.00.00")) Or (.dataMax <> CDate("0.00.00") And .dataMin = CDate("0.00.00")) Then
            Exit Sub
        End If
        If .indexUtente <> 0 Then
            strUtente = " AND CODICE_UTENTE=" & .indexUtente
        End If
        If .unSoloTipo Then
            strUtente = " AND TIPO=" & .tipo
        End If
    End With
    riga = 0
    flxGriglia.Rows = 1
    
    Set rsDataset = New Recordset
    rsDataset.Open "SELECT * FROM (LOGIN INNER JOIN ACCESSI ON LOGIN.KEY=ACCESSI.CODICE_UTENTE) WHERE TRUE " & strData & strUtente & " ORDER BY DATA DESC", cnPrinc, adOpenForwardOnly, adLockReadOnly, adCmdText
    If Not (rsDataset.EOF And rsDataset.BOF) Then
        With flxGriglia
            Do While Not rsDataset.EOF
                riga = riga + 1
                .Rows = riga + 1
                .TextMatrix(riga, 0) = rsDataset("ACCESSI.KEY")
                .TextMatrix(riga, 1) = rsDataset("NOME")
                .TextMatrix(riga, 2) = rsDataset("COGNOME")
                .TextMatrix(riga, 3) = Choose(rsDataset("TIPO"), "Medico", "Infermiere", "Contabile", "Amministratore")
                .TextMatrix(riga, 4) = rsDataset("DATA")
                .TextMatrix(riga, 5) = Format(rsDataset("ORA"), "Short Time")
                .TextMatrix(riga, 6) = rsDataset("NOME_PC")
                .TextMatrix(riga, 7) = IIf(rsDataset("TIPO_PC") = 1, "Server", "Client")
                rsDataset.MoveNext
            Loop
        End With
    Else
        'MsgBox "Nessun accesso trovato", vbInformation, "Isodial Utility"
    End If
    Set rsDataset = Nothing
End Sub

Private Sub flxGriglia_GotFocus()
    Call WheelHook(Me, flxGriglia)
End Sub

Private Sub flxGriglia_LostFocus()
    Call WheelUnHook
End Sub

Private Sub flxGriglia_Click()
    If Not VerificaClickFlx(flxGriglia) Then
        ' discolora
        Call ColoraFlx(flxGriglia, flxGriglia.Cols - 1, vbWhite)
        ' annulla le row e col
        flxGriglia.Row = 0
        flxGriglia.Col = 0
    Else
        Call ColoraFlx(flxGriglia, flxGriglia.Cols - 1)
    End If
End Sub

Private Sub flxGriglia_DblClick()
    Dim i As Integer
    If Not VerificaClickFlx(flxGriglia) Then Exit Sub
    With flxGriglia
        ReDim v_nomi(.Cols - 1)
        ReDim v_val(.Cols - 1)
        For i = 1 To .Cols - 1
            v_nomi(i) = .TextMatrix(0, i)
            v_val(i) = .TextMatrix(.Row, i)
        Next i
    End With
    tVisualizza = tpACCESSI
    frmVisualizza.Show 1
End Sub

Private Sub lblFiltro_Change()
    With frmMain
        tFiltro.indexUtente = IIf(.flxUtenti.Row = 0, 0, .flxUtenti.TextMatrix(.flxUtenti.Row, 0))
        tFiltro.dataMin = IIf(.lblData(0) = "", 0, .lblData(0))
        tFiltro.dataMax = IIf(.lblData(1) = "", 0, .lblData(1))
        tFiltro.unSoloTipo = (.chkUnSoloTipo.Value = Checked)
        tFiltro.tipo = .cboTipo.ListIndex + 1
    End With
    Call CaricaFlx
End Sub

